home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / INLINE.LZH / UNINLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1986-10-06  |  23KB  |  835 lines
  1.                           {UNINLINE6}
  2. (*********  Source code Copyright 1986, by L. David Baldwin   *********)
  3.  
  4. {Compiling with mAx=1000 will give sufficient heap for most applications
  5.  and prevent overwriting COMMAND.COM in most cases.}
  6. {
  7. {
  8. From UNAS46
  9. }
  10. program Inline_disasm;
  11. {$v-}{$k-}{$c+}
  12. const
  13.   tab = 9;
  14.   signon1 : string[35] = ^M^J'Inline Disassembler, Vers 1.0'^m^j;
  15.   signon2 : string[40] = '(C) Copyright 1986 by L. David Baldwin'^m^j;
  16.  
  17.   ulen=80;
  18.   symbolleng=28;
  19.   maxbyte=maxint;
  20.   tokenleng=7;
  21.   maxlabels=300;
  22.   PhraseOk=true;
  23.   firsttab=7;
  24.   secondtab=15;
  25. type
  26.   byteptr=^byte;
  27.   word=integer;
  28.   ptrrec=record r,s :word; end;
  29.   string8=string[8];
  30.   string127=string[127];
  31.   regtype = record
  32.               ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  33.             end;
  34.   string2=array[1..2] of char;
  35.   filestring=string[64];
  36.   regstrtype=array[0..15] of array[1..2] of char;
  37.   segregtype=array[0..3] of array[1..2] of char;
  38.  
  39. {Packet holds a displacement which may be either in phrase form (symbolic
  40.   expression) or numeric form.  It may be of byte or word size}
  41.   packet =record
  42.            dispsize :(bytesize,wordsize);
  43.            case phrase : boolean of  {either a numeric or symbollic phrase}
  44.               true   :(s :string[symbolleng]);
  45.               false  :(value : integer);
  46.            end;
  47.   line = record  {Disassembled instruction is built up in a 'line'}
  48.           case boolean of
  49.             true:  (s:string[ulen]);
  50.             false :(len : byte; PCsave : integer);
  51.            end;
  52. var
  53.   ustring : line;
  54.   chi,PC,PCstart,PCfinish : integer;
  55.   nvalue :word;
  56.   token : string[tokenleng];
  57.   pair : string2;
  58.   lch : char absolute pair;
  59.   uch     :char;
  60.   st      :string127;
  61.   symname:string[symbolleng];
  62.   eofinf,bytepending,firsttime,wd,toreg,prefixfl,Wait_Found : boolean;
  63.   reg,mode,rm : word;
  64.   opcode,pendingbyte :byte;
  65.   usindex,tindex,labelindx,Errcount : integer;
  66.   TextArray : array[0..maxbyte] of char;
  67.   inf,outf : text;
  68.   labels : array[0..maxlabels] of record          {Holds info on needed labels}
  69.              PCvalue : integer; found : boolean;
  70.              end;
  71.  
  72. Const opcodes : array[0..$ff] of byte = (
  73.    5,5,5,5,5,5,73,71,69,69,69,69,69,69,73,20,
  74.    4,4,4,4,4,4,73,71,86,86,86,86,86,86,73,71,
  75.    6,6,6,6,6,6,24,18,97,97,97,97,97,97,16,19,
  76.    102,102,102,102,102,102,91,0,13,13,13,13,13,13,23,3,
  77.    29,29,29,29,29,29,29,29,21,21,21,21,21,21,21,21,
  78.    73,73,73,73,73,73,73,73,71,71,71,71,71,71,71,71,
  79.    20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,
  80.    49,46,34,41,37,43,35,42,51,48,50,47,38,44,39,45,
  81.    20,20,20,20,98,98,100,100,62,62,62,62,62,54,62,71,
  82.    67,100,100,100,100,100,100,100,8,17,7,99,74,72,84,52,
  83.    62,62,62,62,63,64,14,15,98,98,95,96,57,58,87,88,
  84.    62,62,62,62,62,62,62,62,62,62,62,62,62,62,62,62,
  85.    20,20,80,80,55,53,62,62,20,20,81,81,32,30,31,33,
  86.    20,20,20,20,2,1,20,101,20,20,20,20,20,20,20,20,
  87.    61,60,59,36,28,28,70,70,7,40,40,40,28,28,70,70,
  88.    56,20,79,78,25,12,20,20,9,92,11,94,10,93,20,20);
  89.  
  90. Const grp1_2names : array[0..15] of byte =
  91.                (98,75,68,66,65,27,22,26,29,21,7,7,40,40,73,75);
  92.  
  93. Const shiftnames : array[0..7] of byte =(82,83,76,77,89,90,75,85);
  94.  
  95. Const immednames : array[0..7] of byte = (5,69,4,86,6,97,102,13);
  96.  
  97. Const instrnames : array[0..102] of string[6] = (
  98. 'AAA',  'AAD',   'AAM',  'AAS',  'ADC',  'ADD',  'AND',  'CALL', 'CBW',  'CLC',
  99. 'CLD',  'CLI',   'CMC',  'CMP',  'CMPSB','CMPSW','CS:',  'CWD',  'DAA',  'DAS',
  100. 'DB',   'DEC',   'DIV',  'DS:',  'ES:',  'HLT',  'IDIV', 'IMUL', 'IN',   'INC',
  101. 'INT',  'INTO',  'INT 3','IRET', 'JB',   'JBE',  'JCXZ', 'JZ',   'JL',   'JLE',
  102. 'JMP',  'JNB',   'JA',   'JNZ',  'JGE',  'JG',   'JNO',  'JPO',  'JNS',  'JO',
  103. 'JPE',  'JS',    'LAHF', 'LDS',  'LEA',  'LES',  'LOCK', 'LODSB','LODSW','LOOP',
  104. 'LOOPE','LOOPNE','MOV',  'MOVSB','MOVSW','MUL',  'NEG',  'NOP',  'NOT',  'OR',
  105. 'OUT',  'POP',   'POPF', 'PUSH', 'PUSHF','???',  'RCL',  'RCR',  'REPE', 'REPNE',
  106. 'RET',  'RETF',  'ROL',  'ROR',  'SAHF' ,'SAR',  'SBB',  'SCASB','SCASW','SHL',
  107. 'SHR',  'SS:',   'STC',  'STD',  'STI',  'STOSB','STOSW','SUB',  'TEST', 'WAIT',
  108. 'XCHG', 'XLAT',  'XOR');
  109.  
  110.  
  111. const   regstr : regstrtype = (
  112.                 'AX','CX','DX','BX','SP','BP','SI','DI',
  113.                 'AL','CL','DL','BL','AH','CH','DH','BH');
  114.         segregstr : segregtype = ('ES','CS','SS','DS');
  115.  
  116.  
  117. {-------------OutUstring}
  118. PROCEDURE OutUstring;
  119. var tmp : integer;
  120. begin
  121. (* WriteLn(ustring.s);      *)
  122. if tindex < maxbyte-ulen then
  123.   begin
  124.   tmp:=ustring.len+1;
  125.   move(ustring, TextArray[tindex], tmp);
  126.   tindex:=tindex+tmp;
  127.   end
  128. else
  129.   begin
  130.   WriteLn('Output Array Overflow');
  131.   Halt(1);
  132.   end;
  133. end;
  134.  
  135. {-------------Error}
  136. procedure Error(ii :integer; s :string127);
  137. var x,y : integer;
  138.   newS : string127;
  139. begin
  140. gotoxy(1,wherey);
  141. writeln(st);
  142. y:=wherey;
  143. x:=ii-3; if x<1 then x:=1;
  144. gotoxy(x, y);
  145. write('^');
  146. if S[0]>#0 then  NewS:='Error, '+S else NewS:='Error';
  147. if x+ord(NewS[0])>80 then x:=x-ord(NewS[0]) else x:=x+1;
  148. gotoxy(x,y);  WriteLn(News);
  149. Errcount:=succ(Errcount);
  150. if Errcount>6 then
  151.   begin
  152.   Writeln('Excessive Number of Errors');
  153.   Halt(1);
  154.   end;
  155. end;
  156.  
  157.  
  158. PROCEDURE byteerr; forward;
  159. PROCEDURE Numbyteerr; forward;
  160. {$I unpars.inc}
  161.  
  162. {-------------insrtchr}
  163. procedure insrtchr(c :char);
  164. begin
  165. ustring.s[usindex]:=c;
  166. if ustring.len<usindex then ustring.len:=usindex;
  167. usindex:=usindex+1;
  168. end;
  169.  
  170. {-------------comma}
  171. procedure comma;
  172. begin  insrtchr(','); end;
  173.  
  174. {-------------insrtst}
  175. procedure insrtst(s :string127);
  176. var     k       :integer;
  177. begin
  178. for k:=1 to ord(s[0]) do
  179.    begin
  180.    insrtchr(s[k]);
  181.    end;
  182. end;
  183.  
  184. type string4=string[4];
  185. {-------------Hex2}
  186. FUNCTION Hex2(b :byte): string4;
  187. const HexDigs :array[0..15] of char = '0123456789ABCDEF';
  188. var bz :byte;
  189. begin
  190. bz:=b and $f;  b:=b shr 4;
  191. Hex2:=HexDigs[b]+HexDigs[bz];
  192. end;
  193.  
  194. {-------------Hex4}
  195. FUNCTION Hex4(w :integer): string4;
  196. begin Hex4:=Hex2(hi(w))+Hex2(lo(w)); end;
  197.  
  198. {-------------insrthx2}
  199. procedure insrthx2(b :byte);
  200. begin
  201. insrtchr('$');
  202. insrtst(Hex2(b));
  203. end;
  204.  
  205. {-------------insrthx4}
  206. procedure insrthx4(w :word);
  207. begin
  208. insrtchr('$');
  209. insrtst(Hex4(w));
  210. end;
  211.  
  212. {-------------insrtdisp}
  213. procedure insrtdisp(disp : packet);
  214. begin
  215. with disp do
  216.   if not phrase then
  217.     begin
  218.     if (dispsize=bytesize)  then
  219.        begin
  220.        if value and $80 <>0 then
  221.           begin
  222.           insrtchr('-');  {turn into negative number}
  223.           value:=-(value or $FF00);
  224.           end
  225.        else insrtchr('+');
  226.        insrthx2(lo(value));
  227.        end
  228.     else
  229.        insrthx4(value);
  230.     end
  231.   else insrtst(s);
  232. end;
  233.  
  234. {-------------FormLabel}
  235. FUNCTION FormLabel(N : integer): string8;
  236. var S : string8;
  237. begin
  238. str(N,S);
  239. FormLabel:='X'+S;
  240. end;
  241.  
  242. {-------------outlabel}
  243. PROCEDURE outlabel(n : integer);
  244.  
  245.   PROCEDURE AddLabel(N : integer);
  246.   var I : Integer; fnd : boolean;
  247.   begin
  248.   fnd:=false;   {only add label if it isn't already there}
  249.   I:=0;
  250.   while (I<labelindx) and not fnd do
  251.     begin fnd:=Labels[I].PCvalue=N;  I:=succ(I); end;
  252.   if not fnd then
  253.     if labelindx<=maxlabels then
  254.       with Labels[labelindx] do
  255.         begin
  256.         PCvalue:=N;
  257.         found:=false;   {will try to find it later}
  258.         labelindx:=succ(labelindx);
  259.         end;
  260.   end;
  261. begin
  262. AddLabel(N);
  263. Insrtst(FormLabel(N));
  264. end;
  265.  
  266. {-------------byteerr}
  267. PROCEDURE byteerr;
  268. begin
  269. error(chi,'Byte Exp');
  270. next;  {pass it by}
  271. PC:=succ(PC);
  272. end;
  273.  
  274. {-------------NumByteErr}
  275. PROCEDURE NumByteErr;
  276. begin
  277. error(chi,'Numerical Byte Exp');
  278. next;  {pass it by}
  279. PC:=succ(PC);
  280. end;
  281.  
  282. {-------------shortjump}
  283. procedure shortjump;
  284. {the short jump instructions}
  285. var pk : packet;
  286.     vl : word;
  287. begin
  288. if not getbyte(pk,PhraseOk) then byteerr;
  289. if (opcode=$eb) then insrtst('SHORT ');
  290. with pk do
  291.   if not phrase then
  292.     begin
  293.     vl:=value;
  294.     if (vl and $80 <>0) then vl:=vl or $FF00;  {sign extend}
  295.     vl:=vl+PC;
  296.     outlabel(vl);
  297.     end
  298.   else insrtdisp(pk);
  299. end;
  300.  
  301. {-------------intraseg}
  302. procedure intraseg;
  303. {the intrasegment direct jumps and calls}
  304. var pk : packet;
  305. begin
  306. getword(pk);
  307. insrtst('NEAR ');
  308. if not pk.phrase then outlabel(pk.value+PC)
  309.   else insrtdisp(pk);
  310. end;
  311.  
  312. {-------------interseg}
  313. procedure interseg;
  314. {the intersegment direct jumps and calls}
  315. var segm,ofst : packet;
  316. begin
  317. getword(ofst);  getword(segm);
  318. insrtst('FAR ');
  319. insrtdisp(segm); insrtst(':'); insrtdisp(ofst);
  320. end;
  321.  
  322. {-------------movimtoreg}
  323. procedure movimtoreg;
  324. {the move immediate to a reg such as mov bl,12 }
  325. var disp : packet;
  326. begin
  327. reg:=(opcode and $f) xor 8;
  328. insrtst(regstr[reg]);  comma;
  329. if (opcode and 8)<>0 {word} then
  330.     getword(disp)
  331. else
  332.     if not getbyte(disp,PhraseOk) then byteerr;
  333. insrtdisp(disp);
  334. end;
  335.  
  336. {-------------domem}
  337. procedure domem(disp : packet);
  338. type  rptype=array[0..7] of string[5];
  339. const regphrase : rptype = (
  340.          'BX+SI','BX+DI','BP+SI','BP+DI','SI','DI','BP','BX');
  341.  
  342. begin
  343. if mode=3 then
  344.    begin        {its a reg}
  345.    if not wd then rm:=rm+8;
  346.    insrtst(regstr[rm]);
  347.    end
  348. else
  349.    begin        {its a memory}
  350.    insrtchr('[');
  351.    if (rm=6) and (mode=0) then
  352.       insrtdisp(disp)
  353.    else
  354.       begin     {need a register phrase}
  355.       insrtst(regphrase[rm]);
  356.       if mode<>0 then
  357.          begin
  358.          if (disp.dispsize=wordsize) or disp.phrase then insrtchr('+');
  359.          insrtdisp(disp);
  360.          end;
  361.       end;
  362.    insrtchr(']');
  363.    end;
  364. end;
  365.  
  366. {-------------doreg}
  367. procedure doreg;
  368. begin
  369. if not wd then reg:=reg+8;
  370. insrtst(regstr[reg]);
  371. end;
  372.  
  373. {-------------readmodebyte}
  374. procedure readmodebyte(var disp : packet);
  375. {read the mode byte and sort out the various parts.  read the
  376.  displacement byte or word if req'D}
  377. var modebyte : byte;
  378.     pk : packet;
  379. begin
  380. if not getbyte(pk, not PhraseOk) then Numbyteerr;
  381. modebyte:=lo(pk.value);
  382. rm:=modebyte and 7;
  383. mode:=(modebyte and $c0) div 64;
  384. reg:=(modebyte and $38) div 8;
  385. if (mode=0) and (rm=6) or (mode=2) then
  386.    getword(disp)        {get address or 16 bit disp}
  387. else if mode=1 then     {its a 8 bit displ}
  388.    if not getbyte(disp, PhraseOk) then byteerr;
  389. end;
  390.  
  391. {-------------memseg}
  392. procedure memseg;
  393. {move seg reg to/from mem/reg}
  394. var disp : packet;
  395. begin
  396. toreg:=(opcode and 2)<>0;
  397. wd:=true;
  398. readmodebyte(disp);
  399. reg:=reg and 3; {0..3}
  400. if toreg then
  401.    begin insrtst(segregstr[reg]);  comma; domem(disp);  end
  402. else
  403.    begin domem(disp); comma; insrtst(segregstr[reg]); end;
  404. end;
  405.  
  406. {-------------imedtoac}
  407. procedure imedtoac;     {do the immediates to ac}
  408. var disp : packet;
  409. begin
  410. wd:=(opcode and 1)<>0;
  411. reg:=0;         {ax or al}
  412. if wd then
  413.    getword(disp)
  414. else
  415.    if not getbyte(disp, PhraseOk) then byteerr;
  416. doreg; comma;
  417. if wd or disp.phrase then insrtdisp(disp)
  418.   else insrthx2(lo(disp.value));  {no sign}
  419. end;
  420.  
  421. {-------------immed}
  422. procedure immed;        {add reg/mem,12   xor reg/mem,1234}
  423. var     signext :boolean;
  424.         d1,d2 : packet;
  425. begin
  426. wd:=(opcode and 1)<>0;
  427. signext:=((opcode and 2)<>0) and (opcode<=$83);{mov does not have sign ext}
  428. readmodebyte(d1);
  429. if opcode<=$83 then     {mov has name output already}
  430.    insrtst(instrnames[immednames[reg]]);
  431. usindex:=secondtab;
  432. if wd and not signext then
  433.   getword(d2)
  434. else
  435.   if not getbyte(d2, PhraseOk) then byteerr;
  436. if mode<>3 then
  437.    begin
  438.    if wd then insrtst('WORD PTR ')
  439.    else insrtst('BYTE PTR ');
  440.    end;
  441. domem(d1); comma;
  442. insrtdisp(d2);
  443. end;
  444.  
  445. {$I flpt.inc}
  446.  
  447. {-------------doshift}
  448. procedure doshift;      {do the shift and rotate instr}
  449. var pk : packet;
  450. begin
  451. wd:=(opcode and 1)<>0;
  452. readmodebyte(pk);
  453. insrtst(instrnames[shiftnames[reg]]);
  454. usindex:=secondtab;
  455. if mode<>3 then
  456.    begin
  457.    if wd then insrtst('WORD PTR ')
  458.    else insrtst('BYTE PTR ');
  459.    end;
  460. domem(pk); comma;
  461. if (opcode and 2)<>0 then
  462.    insrtst('CL') else insrtst('1');
  463. end;
  464.  
  465. {-------------dogroup1_2}
  466. procedure dogroup1_2;   {f6,f7,fe,ff}
  467. var pk : packet;
  468. begin
  469. wd:=(opcode and 1)<>0;
  470. readmodebyte(pk);
  471. if (opcode and 8)<>0 then reg:=reg+8;   {reg is ptr to name in this case}
  472. if (opcode=$fe) then if (reg>=$a) then
  473.    reg:=$f;     {no call, jmp, push of bytes}
  474. insrtst(instrnames[grp1_2names[reg]]);
  475. usindex:=secondtab;
  476. if (reg=$a) or (reg=$c) then insrtst('NEAR ')
  477. else if (reg=$b) or (reg=$d) then insrtst('FAR ')
  478. else if (mode<>3) then if (reg<>$e) {push}  then
  479.    begin
  480.    if wd then insrtst('WORD PTR ')
  481.    else insrtst('BYTE PTR ');
  482.    end;
  483. domem(pk);
  484. if reg=0 then
  485.    begin        {test}
  486.    comma;
  487.    if wd then begin getword(pk); insrtdisp(pk); end
  488.    else
  489.      begin
  490.      if not getbyte(pk, PhraseOk) then byteerr;
  491.      if pk.phrase then insrtdisp(pk)
  492.      else insrthx2(lo(pk.value));       {no sign}
  493.      end;
  494.    end;
  495. end;
  496.  
  497. {-------------memtoreg}
  498. procedure memtoreg;
  499. {lds,les,lea}
  500. var pk : packet;
  501. begin
  502. wd:=true; toreg:=true;
  503. readmodebyte(pk);
  504. doreg; comma;
  505. domem(pk);
  506. end;
  507.  
  508. {-------------memaccum}
  509. procedure memaccum;
  510. {handle mov ac,[1234] , cmp ac,[5678] etc}
  511. var disp : packet;
  512. begin
  513. wd:=(opcode and 1)<>0;
  514. toreg:=(opcode and 2)=0;        {note the difference in sense}
  515. reg:=0; {will be ax or al}
  516. getword(disp);
  517. rm:=6; mode:=0;         {for displacement only}
  518. if toreg then
  519.    begin doreg; comma; domem(disp); end
  520. else
  521.    begin domem(disp); comma; doreg; end;
  522. end;
  523.  
  524. {-------------mregmreg}
  525. procedure mregmreg;
  526. {do the mem/reg, mem/reg instructions, such as mov bx,[bp+1234]
  527.  or add [bx],dx }
  528. var pk : packet;
  529. begin
  530. wd:=(opcode and 1)<>0;
  531. toreg:=(opcode and 2)<>0;
  532. readmodebyte(pk);
  533. if toreg then
  534.    begin doreg; comma; domem(pk); end
  535. else
  536.    begin domem(pk); comma; doreg; end;
  537. end;
  538.  
  539. {-------------rep_lock}
  540. procedure rep_lock;     {do lock, repe, repne,wait, and seg overrides}
  541. begin
  542. prefixfl:=true;
  543. OutUstring;
  544. end;
  545.  
  546. {-------------unassem1}
  547. procedure unassem1;
  548. {unassemble one line of code (or two if preceeded by a seg instruction)
  549.  output the unassembled line in ustring.}
  550. label 10;
  551. const
  552.   dolater : set of byte = [$9B,$f6,$f7,$fe,$ff,$d0..$d3,$d8..$df,$80..$83];
  553. var
  554.   pk : packet;
  555.   err : boolean;
  556.     PROCEDURE insbyte;
  557.     var pk1 : packet;
  558.     begin
  559.     if not getbyte(pk1, PhraseOk) then byteerr;
  560.     if pk1.phrase then insrtdisp(pk1) else insrthx2(lo(pk1.value));
  561.     end;
  562. begin
  563. Wait_Found:=false;
  564. repeat
  565.   prefixfl:=false;      {set true later if a segm overide instr found}
  566.   ustring.len:=0;
  567.   fillchar(ustring.s[1], ulen, ' ');     {clear ustring}
  568.   ustring.PCsave:=PC;
  569.   repeat
  570.     err:=not getbyte(pk, not PhraseOk);
  571.     if err then begin Numbyteerr; Next; end;
  572.     opcode:=pk.value;
  573.   until not err;
  574.   usindex:=firsttab;
  575.   if not (opcode in dolater) then
  576.     begin       {most items have opcode name output now}
  577.     insrtst(instrnames[opcodes[opcode]]);
  578.     usindex:=secondtab;
  579.     end;
  580.   case opcode of
  581.         $27,$2f,$37,$3f,
  582.         $90,$98,$99,$9c..$9f,$aa..$af,$a4..$a7,
  583.         $c3,$cb,$cc,$ce,$cf,$d7,$f4,$f5,
  584.         $f8..$fd        :;      {opcode only}
  585.  
  586.         $26,$36,$2e,$3e,                {seg overide inst}
  587.         $f0,$f2,$f3     :rep_lock;      {lock, repe, repne}
  588.  
  589.         $40..$5f,
  590.         $91..$97        :begin
  591.                          insrtst(regstr[opcode and 7]); {push,pop,xchg
  592.                                                              inc,dec}
  593.                          if opcode>=$91 then
  594.                            insrtst(',AX');      {xchg}
  595.                          end;
  596.  
  597.         0..3,8..$b,$10..$13,$18..$1b,
  598.         $20..$23,$28..$2b,$30..$33,$38..$3b,$84..$87,
  599.         $88..$8b        :mregmreg;
  600.   
  601.         $b0..$bf        :movimtoreg;    {mov cx,1234 etc.}
  602.         
  603.         $70..$7f,$e0..$e3,
  604.         $eb             :shortjump;
  605.  
  606.         $e8,$e9         :intraseg;
  607.         
  608.         $ea,$9a         :interseg;
  609.         
  610.         6,7,$e,$16,$17,$1e,$1f
  611.                         :begin          {seg, push-pop seg}
  612.                          reg:=(opcode div 8) and 3;
  613.                          insrtst(segregstr[reg]);
  614.                          end;
  615.         $4,$5,$c,$d,$14,$15,$1c,$1d,$24,$25,$2c,$2d,$34,$35,$3c,$3d,
  616.         $a8,$a9         :imedtoac;
  617.  
  618.         $a0..$a3        :memaccum;      {mov ac,[1234] }
  619.  
  620.         $c4,$c5,$8d     :memtoreg;      {les,lds,lea}
  621.         
  622.         $cd             :insbyte;       {int n}
  623.         
  624.         $ee,$ef         :begin  {out dx,ac}
  625.                          wd:=true; reg:=2;
  626.                          doreg;
  627. 10:                      comma;
  628.                          wd:=(opcode and 1)<>0;
  629.                          reg:=0;        {ax or al}
  630.                          doreg;
  631.                          end;
  632.  
  633.         $e4,$e5,$ec,$ed :begin  {in ac, dx or port}
  634.                          wd:=(opcode and 1)<>0;
  635.                          reg:=0;
  636.                          doreg;
  637.                          comma;
  638.                          if (opcode>=$ec) then
  639.                             begin wd:=true; reg:=2; doreg; end
  640.                          else insbyte;
  641.                          end;
  642.  
  643.         $e6,$e7         :begin  {out port,ac}
  644.                          insbyte;
  645.                          goto 10;
  646.                          end;
  647.  
  648.         $8c,$8e         :memseg;        {segment, reg instr}
  649.  
  650.         $f6,$f7,$fe,$ff :dogroup1_2;
  651.  
  652.         $d0..$d3        :doshift;
  653.  
  654.         $80..$83,$c6,$c7:immed;
  655.  
  656.         $8f             :begin
  657.                          wd:=true;      {pop reg/mem}
  658.                          readmodebyte(pk);
  659.                          domem(pk);
  660.                          end;
  661.         $c2,$ca         :begin getword(pk);insrtdisp(pk); end;     {ret n}
  662.         $d4,$d5         :begin                           {aam,aad}
  663.                          if not getbyte(pk,PhraseOk) then byteerr;
  664.                          if not pk.phrase then
  665.                            if pk.value<>$a then insrthx2(lo(pk.value));
  666.                          end;
  667.  
  668.         $9B             :{WAIT - look to see if it preceeds a Fl Point instr}
  669.                          if((sy=wordsy) or (sy=bytesy)) and (lo(nvalue)>=$d8)
  670.                             and (lo(nvalue)<=$df) then
  671.                               begin Wait_found:=true; Prefixfl:=true; end
  672.                               else insrtst(instrnames[opcodes[$9B]]);
  673.                                         {plain wait}
  674.         $da,$de         :da_de;
  675.         $d8,$dc         :d8_dc;
  676.         $d9             :d9;
  677.         $db             :db;
  678.         $dd             :dd;
  679.         $df             :df;
  680.  
  681.      else  insrthx2(opcode);       {for db (databyte)}
  682.      end;       {case}
  683. until prefixfl=false;
  684. OutUstring;
  685. end;
  686.  
  687. {-------------chk_ioerror}
  688. FUNCTION chk_ioerror(S : filestring): Integer;
  689. var ioerr : Integer;
  690. begin
  691. ioerr := IOResult;
  692. if ioerr = 1 then WriteLn('Can''t find ', S)
  693. else if ioerr <> 0 then WriteLn('I/O Error ', Hex4(ioerr));
  694. chk_ioerror := ioerr;
  695. end;
  696.  
  697. {-------------PromptForInput}
  698. PROCEDURE PromptForInput;
  699. var
  700.   inname,name : filestring;
  701.   err : Integer;
  702. begin
  703. {$I-}
  704. Repeat
  705.   Write('Inline Object Filename [.OBJ]: '); ReadLn(inname);
  706.   if inname='' then Halt;
  707.   DefaultExtension('OBJ', inname, name);
  708.   Assign(inf, inname); Reset(inf);
  709.   err:=chk_ioerror(inname);
  710.   if err>1 then Halt(1);
  711. until err=0;
  712.  
  713. Write('Assembly Language Source Filename [', name, '.ASM]: '); ReadLn(inname);
  714. if inname='' then inname:=name;   {Use the same name}
  715. DefaultExtension('ASM',inname,name);
  716. Assign(outf, inname);
  717. ReWrite(outf);
  718. if chk_ioerror(inname)<>0 then Halt(1);
  719. {$I+}
  720. end;
  721.  
  722. {-------------CommandInput}
  723. PROCEDURE CommandInput;
  724. var
  725.   inname,name : filestring;
  726.  
  727.   PROCEDURE DoHelp;
  728.   begin
  729.   Halt;
  730.   end;
  731.  
  732. begin
  733. inname:=ParamStr(1);
  734. if Pos('?', inname)<>0 then DoHelp;
  735. DefaultExtension('OBJ', inname, name);
  736. {$I-}
  737. Assign(inf, inname);
  738. ReSet(inf);
  739. if chk_ioerror(inname)<>0 then Halt(1);
  740. if ParamCount>=2 then inname:=ParamStr(2)
  741.   else inname:=name;             {Use the old name}
  742. DefaultExtension('ASM',inname,name);
  743. Assign(outf, inname);
  744. ReWrite(outf);
  745. if chk_ioerror(inname)<>0 then Halt(1);
  746. {$I+}
  747. end;
  748.  
  749. {-------------ReportLabelErrors}
  750. PROCEDURE ReportLabelErrors;
  751. var I : integer;
  752. begin
  753. if labelindx>maxlabels then
  754.   WriteLn('Number of labels exceeds array capacity');
  755. for I:=0 to labelindx-1 do
  756.   with labels[I] do
  757.     if not found then
  758.       if (PCvalue<PCstart) or (PCvalue>PCfinish) then
  759.         writeln('Label ',FormLabel(PCvalue),' is out of Inline code range')
  760.       else
  761.         writeln('Label ',FormLabel(PCvalue),' cannot be found');
  762. end;
  763.  
  764. {-------------WriteToFile}
  765. PROCEDURE WriteToFile;
  766. var
  767.   P : ^line;
  768.   Px : ptrrec absolute P;
  769.   I,tmp : integer;
  770.   LB : string8;
  771.  
  772.   FUNCTION FindLabel(N : integer): boolean;
  773.   var I : integer;  fnd : boolean;
  774.   begin
  775.   fnd:=false; I:=0;
  776.   while (I<labelindx) and not fnd do
  777.     begin fnd:=labels[I].PCvalue=N;  I:=succ(I); end;
  778.   if fnd then Labels[I-1].found:=true;
  779.   FindLabel:=fnd;
  780.   end;
  781. begin
  782. P:=addr(TextArray);
  783. I:=0;
  784. while I < tindex do  {tindex now is index to last useful byte +1}
  785.   begin
  786.   with P^ do
  787.     begin
  788.     if findlabel(PCsave) then
  789.       begin    {put it into textarray}
  790.       LB:=formlabel(PCsave)+':';  {in string form}
  791.       move(LB[1], S[1], ord(LB[0]));
  792.       end
  793.     else PCsave:=$2020;      {replace integer by 2 spaces}
  794.     WriteLn(outf,S);
  795.     tmp:=len+1;
  796.     end;
  797.   I:=I+tmp;
  798.   Px.r:=Px.r+tmp;
  799.   end;
  800. end;
  801.  
  802. {-------------MAIN}
  803. begin
  804. WriteLn(signon1,signon2);
  805. Errcount:=0;
  806. PC:=0;  bytepending:=false;  firsttime:=true;
  807. if ParamCount >= 1 then CommandInput else PromptForInput;
  808. eofinf:=false;
  809. st[0]:=#0;  chi:=1;  {get the reading started}
  810. getch;
  811. gettoken;
  812. while not eofinf do
  813.   if token='INLINE' then
  814.     begin
  815.     tindex:=0;   {index into TextArray}
  816.     PCstart:=PC; labelindx:=0;
  817.     if not firsttime then
  818.       WriteLn(outf,'NEW');
  819.     next;
  820.     if sy=lparn then next;
  821.     while (sy<>rparn) and not eofinf do unassem1;
  822.     if sy=rparn then gettoken;
  823.     firsttime:=false;
  824.     PCfinish:=PC;
  825.     Ustring.S:='        ';  {Provide for possible label at the end}
  826.     Ustring.PCsave:=PC;
  827.     OutUstring;
  828.     WriteToFile;   {TextArray to outf, adding labels as req'd}
  829.     ReportLabelErrors;
  830.     end
  831.   else gettoken;
  832. close(inf);
  833. close(outf);
  834. end.
  835.